
;; Code for supervisor create-plot and update-plot methods
;; and for Simple regression plot.

(defmeth morals-spreadplot-supervisor-proto :create-plots () 
  (let* ((i 0)
         (j 0)
         (k 0)
         (iteration-list nil)
         (iter-list nil)
         (rsq-beta-list nil)
         (a 0)
         (model (send (send self :model) :morals-model))
         (dv2 (select (send (send self :model) :variables) 
                     (send (send self :model) :dv)))
         (dv (if (listp dv2) (select dv2 0) dv2))
         (pred (strcat "Fitted " dv))
         (count (+ (send model :count) 1))
         (rsq-list (send model :rsq-list))
         (model2 (send self :model))
         (lin-reg (send model2 :lin-reg-model))
         (datamat (send model2 :data-matrix))
         (nobs (send model2 :nobs))
         (plots nil)
         (x (combine (select datamat (iseq nobs) (select 
                                                 (send model2 :iv) 0))))
         (otherxs (select datamat (iseq nobs) (remove 
                                  (select (send model2 :iv) 0)
                                          (send model2 :iv))))
         (simple-reg 
          (= (second (array-dimensions otherxs)) 0));fwy 3.31 10/30/97 
         (y (combine (select datamat (iseq nobs) (send model2 :dv))))
         (yx-mod (regression-model otherxs y :print nil))
         (xx-mod (regression-model otherxs x :print nil))
         
         (iter-cntr (enable-container *iter-container*))
         (rsqp (rsq-plot self nil :variable-labels '("Iterations"
                                            "RSQ & |Beta|")
                              :title "   RSQ, |Beta|"
                              :go-away t
                              :show nil))
         (diff 
          (rsq-plot self t
                    :variable-labels '("Iterations" "Change")
                    :title "     Convergence"
                    :go-away t
                    :show nil))
         (cntr (enable-container *spreadplot-container*))
         (rp1 (residual-plot self (send model :fit-values)
                            (send model :raw-residuals)
                            :go-away t
                            :show nil :title "Residuals"
                            ))
         (ip1 (influence-plot self (send model :fit-values)
                            (send model :cooks-distances)
                            :title "Influence"
                            :go-away t
                            :show nil))
         (tp1 nil)
         (rp2 (residual-plot self (send model :fit-values)
                            (send model :raw-residuals)
                            :show nil
                            :go-away t
                            :title "Residuals"))
         (ip2 (influence-plot self (send model :fit-values)
                            (send model :leverages)
                            :title "Leverage"
                            :menu-title "Leverage"
                            :go-away t
                            :show nil))
         (lr (lin-reg-plot self (send lin-reg :fit-values)
                           (send lin-reg :Y)   
                           :title "Fit/Linear Regression" ;fwy 3.31 10/31/97
                           :go-away t 
                           :show nil))
         ;(var-list (send var-list-proto :new self))
         (obs-list (send obs-list-proto :new self))
         (av (if simple-reg   ;fwy 3.31 10/30/97 changed for simple reg vis
                 (added-var-plot  self x y :show nil :simple-reg simple-reg)
                 (added-var-plot  self 
                                  (send xx-mod :residuals) 
                                  (send yx-mod :residuals) :show nil)))

         (color 'black)
         )
    (setf *diff-plot* diff)
    #+color(when (> *color-mode* 0) (setf color 'blue))
    (setf *current-spreadplot* self)
    (defmeth self :spreadplot-help ()
      (plot-help-window (strcat "SpreadPlot Help"))
      (paste-plot-help (format nil "This is the SpreadPlot for Simple Regression. "))
      (show-plot-help)
      (send spreadplot-proto :spreadplot-help :points t :labels t :flush nil))
    (when simple-reg (send model2 :simple-reg t))
    (if simple-reg ;fwy 3.31 10/30/97 changed for simple reg vis
        
        (send av :variable-label '(0 1)
              (list (select (send model2 :variables) 
                            (select (send model2 :iv) 0))
                    dv))    
        (send av :variable-label '(0 1) 
              (list (strcat (select (send model2 :variables) 
                                    (select (send model2 :iv) 0))
                            "|Other Vars") 
                    (strcat dv "|Other Vars"))))
    
    (if (= (send model :count) 0)
        (setf tp1 (lsmt-plot (send model :YRaw) (send model :Y)
                             (send model :fit-values) self 
                             :title "LS Monotone Transformation" ;
                             :show nil))
        (setf tp1 (lsmt-plot (send model :YRaw) (send model :Y)
                             (send model :YHat) self
                             :title "LS Monotone Transformation"
                             :show nil)))
    ;(when (> (send model :count) 0)
          ;(defmeth tp1 :iter8 ()
          ;  (send (send self :spreadplot-supervisor) :iterate2)
     ;       ))
    (send rp1 :variable-label '(0 1) (list pred "OLS Raw Residuals"))
    (send ip1 :variable-label '(0 1) (list pred "OLS Cook's Distances"))
    (send rp2 :variable-label '(0 1) (list pred "OLS Raw Residuals"))
    (send ip2 :variable-label '(0 1) (list pred "OLS Leverages"))
    (send tp1 :variable-label '(0 1) (list pred dv))
    (send av  :location (select loc11 0) (select loc11 1))
    (send lr  :location (select loc12 0) (select loc12 1)) ;tp1
    (send rp1 :location (select loc13 0) (select loc13 1))
    (send rp2 :location (select loc13 0) (select loc13 1))
    (send ip1 :location (select loc22 0) (select loc22 1))
    (send ip2 :location (select loc23 0) (select loc23 1))
   ; (cond 
   ;   (simple-reg
   ;    (apply #'send av :abline (send model :coef-estimates))
   ;    )
   ;   (t
   ;    (send tp1  :location (select loc12 0) (select loc12 1))
   ;    (send rsqp :location (select loc23 0) (select loc23 1))
   ;    ))
    (send tp1  :location (select loc12 0) (select loc12 1))
    (send rsqp :location (select loc23 0) (select loc23 1))
    (send rsqp :showing-labels t)
    (send rsqp :mouse-mode 'brushing)
    ;(send rsqp :plot-buttons :new-x nil :new-y nil :mouse nil)
    (let ((ovr (send rsqp :overlays)))
      (when ovr
           (send (first (send rsqp :overlays)) :remove-button ':mouse-mode)
           (send (first (send rsqp :overlays)) :remove-button ':zoom)
           (send (first (send rsqp :overlays)) :remove-button ':pop)
           (send (first (send rsqp :overlays)) :install-button ':iterate)))
   ; (defmeth rsqp :iter8 ()
   ;   (send tp1 :iter8))
    (send rsqp :add-subordinate diff)
    (send diff :showing-labels t)
    (send diff :mouse-mode 'brushing)
    ;(send diff :plot-buttons :new-x nil :new-y nil :mouse nil)
    (let ((ovr (send diff :overlays)))
      (when ovr
           (send (first (send diff :overlays)) :remove-button ':mouse-mode)
           (send (first (send diff :overlays)) :remove-button ':zoom)
           (send (first (send diff :overlays)) :remove-button ':pop)
           (send (first (send diff :overlays)) :remove-button ':plot-help)))
    (send lr :showing-labels t)
    (send ip1 :showing-labels t)
    (send ip2 :showing-labels t)
    (send lr :location (select loc12 0) (select loc12 1))
    (send obs-list :location (select loc21 0) (select loc21 1))
    (send obs-list :has-h-scroll (max (screen-size)))
    (send obs-list :has-v-scroll (max (screen-size)))
    (send obs-list :showing-labels t)
    (send obs-list :fix-name-list)
    (send rp1 :abline 0.0 0.0)
    (send rp1 :showing-labels t)
    (send rp2 :abline 0.0 0.0)
    (send rp2 :showing-labels t)
    (send tp1 :showing-labels t)
    (send tp1 :redraw)
    (when simple-reg 
          (send av :title "Fit & Linear Regression"))
    (send av :showing-labels t)
    (send self :residual-plot1 rp1)
    (send self :residual-plot2 rp2)
    (send self :influence-plot1 ip1)
    (send self :influence-plot2 ip2)
    (send self :transformation-plot tp1)
    (send self :lin-reg-plot lr)
    (send self :added-var-plot av)
    ;(send self :var-list var-list)
    (send self :obs-list obs-list)
    (send self :resid-type1 "LR-Raw")
    (send self :resid-type2 "LR-Bayes")
    (send self :infl-type1 "LR-Cooks")
    (send self :infl-type2 "LR-Lev")
    (send self :update-residual-plot)
    
    (when (> (send model :count) 0)
          (dotimes (k count)
             (setf iteration-list (append iteration-list 
                             (list (repeat k (length (first 
                                             (send model :standardized-beta-list)))))))))
    (send rsqp :clear-points)
    (send rsqp :clear-lines)
    (send diff :clear-points)
    (send diff :clear-lines)
    (dotimes (k count)
             (setf iteration-list (append iteration-list 
                             (list (repeat k (length (first 
                                   (send model :standardized-beta-list))))))))
    (dotimes (j (length (first (send model :standardized-beta-list)))) 
             (dotimes (i (length (send model :standardized-beta-list)))  
                      (setf rsq-beta-list (append rsq-beta-list (list 
                          (select (select 
                                  (send model :standardized-beta-list) i) j))))
                      (setf iter-list (append iter-list
                          (list (select (select iteration-list i) j)))))
             (send rsqp :add-lines iter-list (abs rsq-beta-list))
             (send rsqp :add-lines (iseq count) rsq-list)
           ;  (send diff :add-lines iter-list 
           ;        (if (> (length rsq-beta-list) 1)
           ;            (append (- (difference (abs rsq-beta-list))) 
           ;                    (list 0))
           ;            (list 0)))
           ;  (send diff :add-lines (iseq count) rsq-list)
             )
    (setf i 0)
    (setf iter-list nil)
    (setf rsq-beta-list nil)
    (send rsqp :add-points (list (repeat (send model :count) 
            (length (combine (first (send model :standardized-beta-list)))))
                    (combine (first (send model :standardized-beta-list))))
            :point-labels (select (send (send self :model) :variables)
                                (send (send self :model) :iv)))
   ; (send diff :add-points (list (repeat (send model :count) 
   ;         (length (combine (first (send model :standardized-beta-list)))))
   ;                 (combine (first (send model :standardized-beta-list))))
   ;         :point-labels (select (send (send self :model) :variables)
   ;                             (send (send self :model) :iv)))
    (if (= (send model :count) 0)
        (send rsqp :add-points (list 0) (list (send model :r-squared)))
        (send rsqp :add-points (list (send model :count)) 
              (list (select (send model :rsq-list) 
                            (send model :count)))
              :color color
              :point-labels (list "RSQ")))
    (if (= (send model :count) 0)
         (send diff :add-points (list 0) (list 0))
         (send diff :add-points (list (send model :count)) 
               (append (list (- (difference (select (send model :rsq-list)
                                                    (send model :count)))))
                       (list 0))
               :color color
               :point-labels (list "RSQ")))
    (send rsqp :use-color t)
    (send diff :use-color t)
    (send rsqp :location (select loc23 0) (select loc23 1))

;update iteration plots here
    (send self :rsq-beta-plot rsqp)    
    (send self :change-plot diff)

    (mapcar #'(lambda (x) (send x :size (+ plot-size window-decoration-width) 
                                plot-size)
                          (send x :linked t)
                          (send x :adjust-to-data)) (send self :all-plots))
   ; (setf plots (remove (send self :var-list) (send self :all-plots)))
    (setf plots (remove (send self :obs-list) plots))
    (setf plots (append plots (list diff)))
    (when (not simple-reg)
          (mapcar #'(lambda (plot) 
   ;                  (send plot :add-overlay (make-overlay2 plot self))
                      #+color(when (> *color-mode* 0)
                                  (send plot :use-color t)
                                  (send plot :point-color 
                                        (iseq (send plot :num-points)) 'blue))
                      (send plot :mouse-mode 'brushing)
                      (send plot :add-plot-help-item)) 
                  (list av tp1 rp2 obs-list ip1 ip2)));plots
    (cond 
      (simple-reg
       (let ((nptseq (iseq (send av :num-points))))
         (mapcar #'(lambda (plot)
                     #+color(when (> *color-mode* 0)
                                  (send plot :use-color t)
                                  (send plot :point-color nptseq 'blue))
                     (send plot :mouse-mode 'brushing)
                     (send plot :plot-buttons :new-x nil :new-y nil)
                     )
                 (list av lr ip1 ip2))
         (send rp2 :mouse-mode 'brushing)
         (send rp2 :plot-buttons :new-x nil)
         (send obs-list :mouse-mode 'brushing))
       (mapcar #'(lambda (plot) 
                   (send plot :showing t)
                   (send plot :add-plot-help-item));originally had av in list
               (list av lr rp2 obs-list ip1 ip2))) ;tp1 and lr are the same
      (t
       (mapcar #'(lambda (x) (send x :showing t))
               (list av tp1 rp2 obs-list ip1 ip2))))
    
;(mapcar #'(lambda (plot title)
;                (send plot :title title)
;                )
;            (list av tp1 lr rp1 rp2 obs-list ip1 ip2)
;            (list "av" "tp1/lr" "lr" "rp1" "rp2" "obs-list" "ip1" "ip2"))

    (send rsqp :legend1 "   History of")
    (send diff :legend1 "    History of")
    ))



(defmeth morals-spreadplot-supervisor-proto :create-robust-reg-plot ()
  (let* ((mod (send self :model))
         (actcon *active-container*)
         (container (enable-container *REGRES-SPREADPLOT-CONTAINER*))
         (rrp (send robust-reg-plot-proto :new self))
         (robmodel (send (send self :model) :robust-model))
         (labels (send mod :labels))
         (dv2 (select (send mod :variables) (send mod :dv)))
         (dv (if (listp dv2) (select dv2 0) dv2))
         (plot-matrix (send self :plot-matrix))
         )
    (enable-container actcon)
    (send rrp :variable-label '(0 1) 
          (list (strcat "Fitted " dv) dv))
    (send rrp :add-points 
          (send robmodel :fit-values) 
          (send robmodel :y)
          :point-labels labels)
    #+color(when (> *color-mode* 0)
                 (send rrp :use-color t)
                 (send rrp :point-color 
                       (iseq (send rrp :num-points)) 'blue))
    (send rrp :linked t)
    (send rrp :adjust-to-data)
    (send rrp :make-scatterplot-curves)
    (send rrp :regvalues-list nil)
    (send rrp :switch-add-regmeanline)
    (when plot-matrix (setf (aref plot-matrix 0 1) rrp))
    (send self :robust-reg-plot rrp)))


(defmeth morals-spreadplot-supervisor-proto :create-robust-plot (&optional diff-plot)
  (let* ((rob-wt (send self :create-robust-weights-plot))
         (rob-converge (send self :create-robust-weights-plot t))
         )
    (send self :change-plot rob-converge)
    (send self :robust-plot rob-wt)
    (send rob-wt :diff-plot nil)
    (send rob-converge :diff-plot t)
    rob-wt))

(defmeth morals-spreadplot-supervisor-proto :create-robust-weights-plot 
  (&optional diff-plot)
  (let* ((actcon *active-container*)
         (container (enable-container *iter-container*))
         (rp (robust-plot self diff-plot
                       :variable-labels '("Iterations" "Observation Weights")))
         )
    (send rp :update-plot self)
    (cond 
      (diff-plot
       (send (first (send rp :overlays)) :remove-button ':plot-help)
       (send rp :legend2 "Weight Change")
       (send rp :variable-label 1 "Change"))
      (t
       (send (first (send rp :overlays)) :install-button ':iterate)
       (send rp :legend2 "Weight Value")))
    rp))


(defmeth morals-spreadplot-supervisor-proto :update-robust-reg-plot ()
  (let* ((rrp (send self :robust-reg-plot))
         (robmodel (send (send self :model) :robust-model))
         (indices (iseq (send rrp :num-points)))
         )
    (send rrp :point-coordinate 0 indices (send robmodel :fit-values))
    (send rrp :point-coordinate 1 indices (send robmodel :y))
    (send rrp :adjust-to-data)
    ))

(defmeth morals-spreadplot-supervisor-proto :update-robust-plot ()
  (send (send self :robust-plot) :update-plot self)
  (send (send self :change-plot) :update-plot self)
  )


(defmeth morals-spreadplot-supervisor-proto :update-rsq-beta-plot ()
  (send (send self :rsq-beta-plot) :update-plot self)
  (send (send self :change-plot) :update-plot self)
  )
